library("FRESA.CAD")
library(readxl)
library(igraph)
library(umap)
library(tsne)
library(entropy)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)
Data Source https://quantdev.ssri.psu.edu/tutorials/intro-basic-exploratory-factor-analysis
“For this example, we use data from the web that are collected and distributed at https://openpsychometrics.org/_rawdata/. The data were obtained from 19,719 participants (rows) who provided answers to the Big Five Personality Test, constructed with items from the International Personality Item Pool. Data columns include gender, age, race, native language, country, and answers to the 50 likert rated statements (1-5;0 if missed; 1 was labeled as “strongly disagree”, 2 was labeled as “disagree”, 3 was labeled as “neither agree not disagree”, 4 was labeled as “agree” and 5 was labeled as “strongly agree”.) The original files can be obtaned at http://openpsychometrics.org/_rawdata/BIG5.zip”
BigData <- as.data.frame(read_excel("~/GitHub/LatentBiomarkers/Data/BigData.xlsx"))
BigData[BigData==0] <- NA
BigData <- BigData[complete.cases(BigData),]
BigData <- BigData[BigData$age<100,]
BigData <- BigData[,-c(1,3,5,6,7)]
BigData$gender <- 1*(BigData$gender==1)
BigData$age <- log10(BigData$age)
studyName <- "PersonalityAge"
dataframe <- BigData
outcome <- "age"
thro <- 0.20
cexheat <- 0.35
loops <- 30
Some libraries
library(psych)
library(whitening)
library("vioplot")
library("rpart")
library(multiColl)
library(car)
library("pls")
source("C:/Users/jtame/Documents/GitHub/LatentBiomarkers/RMD/RepeatedLinearCV.R")
pander::pander(c(rows=nrow(dataframe),col=ncol(dataframe)-1))
| rows | col |
|---|---|
| 19303 | 51 |
varlist <- colnames(dataframe)
varlist <- varlist[varlist != outcome]
largeSet <- length(varlist) > 1500
set.seed(1)
trainsamples <- sample(nrow(dataframe),3*nrow(dataframe)/4)
trainingset <- dataframe[trainsamples,]
testingset <- dataframe[-trainsamples,]
pander::pander(t(summary(trainingset)))
| age | Min. :1.114 | 1st Qu.:1.255 | Median :1.342 | Mean :1.385 | 3rd Qu.:1.491 | Max. :1.996 |
| gender | Min. :0.0000 | 1st Qu.:0.0000 | Median :0.0000 | Mean :0.3903 | 3rd Qu.:1.0000 | Max. :1.0000 |
| E1 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.644 | 3rd Qu.:4.000 | Max. :5.000 |
| E2 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.756 | 3rd Qu.:4.000 | Max. :5.000 |
| E3 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.424 | 3rd Qu.:4.000 | Max. :5.000 |
| E4 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.149 | 3rd Qu.:4.000 | Max. :5.000 |
| E5 | Min. :1.000 | 1st Qu.:2.000 | Median :4.000 | Mean :3.436 | 3rd Qu.:5.000 | Max. :5.000 |
| E6 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.444 | 3rd Qu.:3.000 | Max. :5.000 |
| E7 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.873 | 3rd Qu.:4.000 | Max. :5.000 |
| E8 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.373 | 3rd Qu.:4.000 | Max. :5.000 |
| E9 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.102 | 3rd Qu.:4.000 | Max. :5.000 |
| E10 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.581 | 3rd Qu.:5.000 | Max. :5.000 |
| N1 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.259 | 3rd Qu.:4.000 | Max. :5.000 |
| N2 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.236 | 3rd Qu.:4.000 | Max. :5.000 |
| N3 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.844 | 3rd Qu.:5.000 | Max. :5.000 |
| N4 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.747 | 3rd Qu.:4.000 | Max. :5.000 |
| N5 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.948 | 3rd Qu.:4.000 | Max. :5.000 |
| N6 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.979 | 3rd Qu.:4.000 | Max. :5.000 |
| N7 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.155 | 3rd Qu.:4.000 | Max. :5.000 |
| N8 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.814 | 3rd Qu.:4.000 | Max. :5.000 |
| N9 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.134 | 3rd Qu.:4.000 | Max. :5.000 |
| N10 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.843 | 3rd Qu.:4.000 | Max. :5.000 |
| A1 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.309 | 3rd Qu.:3.000 | Max. :5.000 |
| A2 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.928 | 3rd Qu.:5.000 | Max. :5.000 |
| A3 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.171 | 3rd Qu.:3.000 | Max. :5.000 |
| A4 | Min. :1.000 | 1st Qu.:4.000 | Median :4.000 | Mean :4.031 | 3rd Qu.:5.000 | Max. :5.000 |
| A5 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.164 | 3rd Qu.:3.000 | Max. :5.000 |
| A6 | Min. :1.0 | 1st Qu.:3.0 | Median :4.0 | Mean :3.9 | 3rd Qu.:5.0 | Max. :5.0 |
| A7 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.157 | 3rd Qu.:3.000 | Max. :5.000 |
| A8 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.771 | 3rd Qu.:5.000 | Max. :5.000 |
| A9 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.944 | 3rd Qu.:5.000 | Max. :5.000 |
| A10 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.682 | 3rd Qu.:5.000 | Max. :5.000 |
| C1 | Min. :1.000 | 1st Qu.:3.000 | Median :3.000 | Mean :3.321 | 3rd Qu.:4.000 | Max. :5.000 |
| C2 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.984 | 3rd Qu.:4.000 | Max. :5.000 |
| C3 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.986 | 3rd Qu.:5.000 | Max. :5.000 |
| C4 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.655 | 3rd Qu.:4.000 | Max. :5.000 |
| C5 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.701 | 3rd Qu.:4.000 | Max. :5.000 |
| C6 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :2.927 | 3rd Qu.:4.000 | Max. :5.000 |
| C7 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.653 | 3rd Qu.:5.000 | Max. :5.000 |
| C8 | Min. :1.000 | 1st Qu.:2.000 | Median :2.000 | Mean :2.486 | 3rd Qu.:3.000 | Max. :5.000 |
| C9 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.226 | 3rd Qu.:4.000 | Max. :5.000 |
| C10 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.637 | 3rd Qu.:4.000 | Max. :5.000 |
| O1 | Min. :1.0 | 1st Qu.:3.0 | Median :4.0 | Mean :3.7 | 3rd Qu.:5.0 | Max. :5.0 |
| O2 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.142 | 3rd Qu.:3.000 | Max. :5.000 |
| O3 | Min. :1.000 | 1st Qu.:4.000 | Median :4.000 | Mean :4.129 | 3rd Qu.:5.000 | Max. :5.000 |
| O4 | Min. :1.000 | 1st Qu.:1.000 | Median :2.000 | Mean :2.073 | 3rd Qu.:3.000 | Max. :5.000 |
| O5 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :3.874 | 3rd Qu.:5.000 | Max. :5.000 |
| O6 | Min. :1.000 | 1st Qu.:1.000 | Median :1.000 | Mean :1.791 | 3rd Qu.:2.000 | Max. :5.000 |
| O7 | Min. :1.000 | 1st Qu.:4.000 | Median :4.000 | Mean :4.076 | 3rd Qu.:5.000 | Max. :5.000 |
| O8 | Min. :1.000 | 1st Qu.:2.000 | Median :3.000 | Mean :3.211 | 3rd Qu.:4.000 | Max. :5.000 |
| O9 | Min. :1.000 | 1st Qu.:4.000 | Median :4.000 | Mean :4.143 | 3rd Qu.:5.000 | Max. :5.000 |
| O10 | Min. :1.000 | 1st Qu.:3.000 | Median :4.000 | Mean :4.008 | 3rd Qu.:5.000 | Max. :5.000 |
varlist <- colnames(trainingset)
varlist <- varlist[varlist != outcome]
The heat map of the data
par(op)
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
cormat <- cor(testingset[,varlist],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
# scale = "row",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Original Correlation",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
diag(cormat) <- 0
pander::pander(max(abs(cormat)))
0.77
par(op)
ILAA bootstrapped training and testing sets
trainage_DE <- ILAA(trainingset,thr=thro,Outcome=outcome,verbose=TRUE)
fast | LM | N8 E1 E2 E3 E4 E5 E6 0.74 0.68 0.76 0.54 0.92 0.66
Included: 50 , Uni p: 0.003 , Base Size: 1 , Rcrit: 0.0228362
1 <R=0.525,thr=0.700>, Top: 1< 1 >Fa= 1,<|><>Tot Used: 2 , Added: 1 , Zero Std: 0 , Max Cor: 0.655
2 <R=0.514,thr=0.600>, Top: 5< 1 >Fa= 6,<|><>Tot Used: 12 , Added: 5 , Zero Std: 0 , Max Cor: 0.591
3 <R=0.470,thr=0.500>, Top: 8< 4 >Fa= 11,<|><>Tot Used: 29 , Added: 13 , Zero Std: 0 , Max Cor: 0.559
4 <R=0.373,thr=0.500>, Top: 1< 1 >Fa= 12,<|><>Tot Used: 31 , Added: 1 , Zero Std: 0 , Max Cor: 0.484
5 <R=0.366,thr=0.400>, Top: 4< 2 >Fa= 13,<|><>Tot Used: 36 , Added: 6 , Zero Std: 0 , Max Cor: 0.421
6 <R=0.339,thr=0.400>, Top: 2< 1 >Fa= 15,<|><>Tot Used: 36 , Added: 2 , Zero Std: 0 , Max Cor: 0.400
7 <R=0.329,thr=0.300>, Top: 13< 1 >Fa= 16,<|><>Tot Used: 48 , Added: 21 , Zero Std: 0 , Max Cor: 0.353
8 <R=0.277,thr=0.300>, Top: 6< 1 >Fa= 18,<|><>Tot Used: 48 , Added: 5 , Zero Std: 0 , Max Cor: 0.298
9 <R=0.257,thr=0.200>, Top: 13< 3 >Fa= 20,<|><>Tot Used: 49 , Added: 22 , Zero Std: 0 , Max Cor: 0.265
10 <R=0.226,thr=0.200>, Top: 7< 2 >Fa= 21,<|><>Tot Used: 49 , Added: 7 , Zero Std: 0 , Max Cor: 0.225
11 <R=0.221,thr=0.200>, Top: 2< 1 >Fa= 21,<|><>Tot Used: 49 , Added: 2 , Zero Std: 0 , Max Cor: 0.199
12 <R=0.199,thr=0.200>
[ 12 ], 0.1993877 Decor Dimension: 49 Nused: 49 . Cor to Base: 37 , ABase: 50 , Outcome Base: 0
#trainage_DE <- ILAA(trainingset,thr=thro,Outcome=outcome,verbose=TRUE,bootstrap=30)
testage_DE <- predictDecorrelate(trainage_DE,testingset)
Generating the formulas
theLaFormulas <- getLatentCoefficients(trainage_DE)
theCharformulas <- attr(theLaFormulas,"LatentCharFormulas")
pander::pander(as.matrix(theCharformulas))
| La_E1 | + E1 - (0.175)E5 - (0.411)E7 |
| La_E2 | + E2 + (0.403)E5 + (0.217)E7 |
| La_E3 | + E3 - (0.357)E5 - (0.299)E7 |
| La_E4 | - (0.297)E2 + E4 + (0.064)E5 + (0.139)E7 - (0.175)E8 - (0.190)E10 |
| La_E6 | - (0.409)E2 + (0.237)E5 + E6 |
| La_E7 | - (0.704)E5 + E7 |
| La_E8 | - (0.230)E2 + (0.258)E5 - (0.050)E7 + E8 |
| La_E9 | - (0.250)E5 + (0.575)E8 + E9 |
| La_E10 | + (0.353)E5 + (0.293)E7 + E10 |
| La_N1 | + N1 - (0.423)N6 - (0.199)N8 |
| La_N2 | + (0.318)N1 + N2 + (0.137)N6 + (0.085)N8 |
| La_N3 | - (0.488)N1 + N3 |
| La_N4 | + N4 + (0.048)N8 + (0.346)N10 |
| La_N5 | + N5 - (0.371)N6 - (0.176)N8 |
| La_N6 | + N6 - (0.525)N8 |
| La_N7 | + N7 - (0.738)N8 |
| La_N9 | - (0.185)N1 - (0.520)N6 - (0.161)N8 + N9 |
| La_N10 | + (0.172)E5 - (0.222)N6 - (0.409)N8 + N10 |
| La_A1 | - (0.073)E5 + A1 + (0.286)A4 - (0.307)A7 |
| La_A2 | - (0.144)E5 + A2 + (0.553)A7 |
| La_A3 | - (0.179)N8 + A3 + (0.363)A4 |
| La_A5 | + (0.276)A4 + A5 - (0.573)A7 |
| La_A6 | - (0.361)A4 + A6 - (0.269)A9 |
| La_A7 | + (0.238)E5 + (0.480)A4 + A7 |
| La_A8 | - (0.311)A4 + A8 - (0.226)A9 |
| La_A9 | - (0.682)A4 + A9 |
| La_A10 | - (0.321)E5 - (0.251)A4 + A10 |
| La_C1 | + C1 + (0.210)C2 |
| La_C3 | - (0.274)C1 + C3 |
| La_C4 | - (0.237)N8 - (0.200)C2 + C4 - (0.313)C6 |
| La_C5 | - (0.289)C1 + (0.196)C2 + C5 - (0.315)C9 |
| La_C6 | + (0.244)C1 - (0.472)C2 + C6 |
| La_C7 | - (0.130)C1 + (0.116)C2 + C7 - (0.298)C9 |
| La_C8 | - (0.187)N8 + (0.336)C1 + C8 |
| La_C9 | - (0.483)C1 + C9 |
| La_C10 | - (0.231)C1 - (0.271)C3 + C10 |
| La_O2 | + (0.329)O1 + O2 |
| La_O3 | - (0.153)O1 + O3 - (0.260)O5 |
| La_O4 | - (0.520)O2 + O4 |
| La_O5 | - (0.260)O1 + O5 |
| La_O6 | + (0.564)O3 + O6 |
| La_O7 | - (0.143)O1 + (0.183)O2 - (0.308)O5 + O7 |
| La_O8 | - (0.710)O1 + O8 |
| La_O10 | - (0.243)O3 - (0.651)O5 + O10 |
Displaying the features associations
par(op)
transform <- attr(trainage_DE,"UPLTM") != 0
colnames(transform) <- str_remove_all(colnames(transform),"La_")
transform <- abs(transform*cor(trainingset[,rownames(transform)])) # The weights are proportional to the observed correlation
VertexSize <- attr(trainage_DE,"fscore") # The size depends on the variable independence relevance (fscore)
names(VertexSize) <- str_remove_all(names(VertexSize),"La_")
VertexSize <- 0.5+9.5*(VertexSize-min(VertexSize))/(max(VertexSize)-min(VertexSize)) # Normalization
VertexSize <- VertexSize[colnames(transform)]
gr <- graph_from_adjacency_matrix(transform,mode = "directed",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr
fc <- cluster_optimal(gr)
# fc <- cluster_walktrap (gr,steps=50)
plot(fc, gr,
edge.width = 2*E(gr)$weight,
vertex.size=VertexSize,
edge.arrow.size=0.5,
edge.arrow.width=0.75,
vertex.label.color="purple",
# vertex.label.cex=0.85,
# vertex.label.dist=1.2,
vertex.label.cex=(0.70 + 0.025*VertexSize),
vertex.label.dist=(0.5 + 0.05*VertexSize),
main="Feature Association")
par(op)
varratios <- attr(trainage_DE,"VarRatio")
names(varratios) <- str_remove_all(names(varratios),"La_")
fscores <- attr(trainage_DE,"fscore")
names(fscores) <- str_remove_all(names(fscores),"La_")
clustable <- as.data.frame(cbind(Variable=fc$names,
Formula=as.character(theCharformulas[paste("La_",fc$names,sep="")]),
Cluster=fc$membership,
ResidualVariance=round(varratios[fc$names],3),
Fscore=round(fscores[fc$names],3)
)
)
rownames(clustable) <- str_replace_all(rownames(clustable),"__","_")
clustable$Variable <- NULL
clustable$Cluster <- as.integer(clustable$Cluster)
clustable$ResidualVariance <- as.numeric(clustable$ResidualVariance)
clustable$Fscore <- as.numeric(clustable$Fscore)
clustable <- clustable[order(-clustable$Fscore),]
clustable <- clustable[order(-clustable$ResidualVariance),]
clustable <- clustable[order(clustable$Cluster),]
pander::pander(as.matrix(clustable))
| Formula | Cluster | ResidualVariance | Fscore | |
|---|---|---|---|---|
| E5 | NA | 1 | 1.000 | 13 |
| E8 | - (0.230)E2 + (0.258)E5 - (0.050)E7 + E8 | 1 | 0.835 | 0 |
| E9 | - (0.250)E5 + (0.575)E8 + E9 | 1 | 0.676 | -2 |
| E2 | + E2 + (0.403)E5 + (0.217)E7 | 1 | 0.671 | 1 |
| E10 | + (0.353)E5 + (0.293)E7 + E10 | 1 | 0.637 | -1 |
| E6 | - (0.409)E2 + (0.237)E5 + E6 | 1 | 0.634 | -2 |
| E1 | + E1 - (0.175)E5 - (0.411)E7 | 1 | 0.630 | -2 |
| E7 | - (0.704)E5 + E7 | 1 | 0.599 | 4 |
| E3 | + E3 - (0.357)E5 - (0.299)E7 | 1 | 0.579 | -2 |
| E4 | - (0.297)E2 + E4 + (0.064)E5 + (0.139)E7 - (0.175)E8 - (0.190)E10 | 1 | 0.557 | -5 |
| N8 | NA | 2 | 1.000 | 11 |
| N4 | + N4 + (0.048)N8 + (0.346)N10 | 2 | 0.837 | -2 |
| N5 | + N5 - (0.371)N6 - (0.176)N8 | 2 | 0.740 | -2 |
| N2 | + (0.318)N1 + N2 + (0.137)N6 + (0.085)N8 | 2 | 0.738 | -3 |
| N6 | + N6 - (0.525)N8 | 2 | 0.712 | 4 |
| N3 | - (0.488)N1 + N3 | 2 | 0.688 | -1 |
| N1 | + N1 - (0.423)N6 - (0.199)N8 | 2 | 0.683 | 1 |
| N10 | + (0.172)E5 - (0.222)N6 - (0.409)N8 + N10 | 2 | 0.645 | -2 |
| N9 | - (0.185)N1 - (0.520)N6 - (0.161)N8 + N9 | 2 | 0.566 | -3 |
| N7 | + N7 - (0.738)N8 | 2 | 0.411 | -1 |
| A4 | NA | 3 | 1.000 | 8 |
| A3 | - (0.179)N8 + A3 + (0.363)A4 | 3 | 0.864 | -2 |
| A1 | - (0.073)E5 + A1 + (0.286)A4 - (0.307)A7 | 3 | 0.843 | -2 |
| A10 | - (0.321)E5 - (0.251)A4 + A10 | 3 | 0.784 | -2 |
| A8 | - (0.311)A4 + A8 - (0.226)A9 | 3 | 0.750 | -2 |
| A7 | + (0.238)E5 + (0.480)A4 + A7 | 3 | 0.729 | 1 |
| A6 | - (0.361)A4 + A6 - (0.269)A9 | 3 | 0.709 | -2 |
| A2 | - (0.144)E5 + A2 + (0.553)A7 | 3 | 0.632 | -2 |
| A5 | + (0.276)A4 + A5 - (0.573)A7 | 3 | 0.614 | -2 |
| A9 | - (0.682)A4 + A9 | 3 | 0.571 | 1 |
| C2 | NA | 4 | 1.000 | 5 |
| C1 | + C1 + (0.210)C2 | 4 | 0.931 | 6 |
| C3 | - (0.274)C1 + C3 | 4 | 0.909 | 0 |
| C8 | - (0.187)N8 + (0.336)C1 + C8 | 4 | 0.844 | -2 |
| C10 | - (0.231)C1 - (0.271)C3 + C10 | 4 | 0.825 | -2 |
| C9 | - (0.483)C1 + C9 | 4 | 0.819 | 1 |
| C7 | - (0.130)C1 + (0.116)C2 + C7 - (0.298)C9 | 4 | 0.807 | -3 |
| C5 | - (0.289)C1 + (0.196)C2 + C5 - (0.315)C9 | 4 | 0.724 | -3 |
| C6 | + (0.244)C1 - (0.472)C2 + C6 | 4 | 0.702 | -1 |
| C4 | - (0.237)N8 - (0.200)C2 + C4 - (0.313)C6 | 4 | 0.684 | -3 |
| O1 | NA | 5 | 1.000 | 5 |
| O5 | - (0.260)O1 + O5 | 5 | 0.905 | 2 |
| O2 | + (0.329)O1 + O2 | 5 | 0.895 | 1 |
| O3 | - (0.153)O1 + O3 - (0.260)O5 | 5 | 0.886 | 0 |
| O7 | - (0.143)O1 + (0.183)O2 - (0.308)O5 + O7 | 5 | 0.748 | -3 |
| O6 | + (0.564)O3 + O6 | 5 | 0.720 | -1 |
| O4 | - (0.520)O2 + O4 | 5 | 0.715 | -1 |
| O8 | - (0.710)O1 + O8 | 5 | 0.605 | -1 |
| O10 | - (0.243)O3 - (0.651)O5 + O10 | 5 | 0.552 | -2 |
The heat map of the ILAA transformed data
par(op)
varlistDe <- colnames(trainage_DE)
varlistDe <- varlistDe[varlistDe != outcome]
par(cex=0.6,cex.main=0.85,cex.axis=0.7)
# Training
cormat <- cor(trainage_DE[,varlistDe],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Training: After ILAA Correlation",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
diag(cormat) <- 0
pander::pander(max(abs(cormat)))
0.199
par(op)
# Testing
cormat <- cor(testage_DE[,varlistDe],method="pearson")
cormat[is.na(cormat)] <- 0
gplots::heatmap.2(abs(cormat),
trace = "none",
mar = c(5,5),
col=rev(heat.colors(5)),
main = "Testing: After ILAA Correlation",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="|Pearson Correlation|",
xlab="Feature", ylab="Feature")
diag(cormat) <- 0
pander::pander(max(abs(cormat)))
0.213
par(op)
outcomeModel <- LASSO_1SE(formula(paste(outcome,"~.")),trainingset);
predOutcome <- predict(outcomeModel,testingset)
pander::pander(as.matrix(outcomeModel$coef))
| (Intercept) | 1.483869 |
| gender | 0.020497 |
| E1 | -0.000793 |
| E2 | 0.002568 |
| E5 | 0.004998 |
| E6 | -0.003737 |
| E9 | -0.008185 |
| E10 | -0.012682 |
| N1 | -0.005191 |
| N2 | -0.014562 |
| N3 | -0.006960 |
| N5 | 0.002689 |
| N6 | 0.000923 |
| N7 | -0.012670 |
| N10 | 0.003161 |
| A1 | -0.007726 |
| A2 | -0.000213 |
| A3 | -0.012584 |
| A4 | 0.001779 |
| A5 | 0.005324 |
| A6 | 0.008162 |
| A7 | 0.002342 |
| A8 | -0.001047 |
| A10 | 0.006571 |
| C1 | -0.003545 |
| C2 | 0.005909 |
| C3 | -0.007768 |
| C4 | -0.009452 |
| C5 | 0.004839 |
| C6 | -0.004175 |
| C7 | 0.003688 |
| C8 | -0.019641 |
| C10 | 0.005771 |
| O1 | 0.011377 |
| O3 | -0.001174 |
| O4 | 0.003396 |
| O5 | 0.010032 |
| O7 | 0.001588 |
| O8 | -0.000314 |
| O9 | 0.006821 |
| O10 | -0.005317 |
rawunittvalues <- apply(as.matrix(testingset[,names(outcomeModel$coef)[-1]]),2,tvals,testingset[,outcome])
names(rawunittvalues) <- names(outcomeModel$coef)[-1]
deunittvalues <- apply(testage_DE[,names(outcomeModel_DE$coef)[-1]],2,tvals,testingset[,outcome])
psig <- 0.1/(ncol(testingset)-1)
lmod <- lm(paste(outcome,"~."),testingset[,c(outcome,names(outcomeModel$coef)[-1])])
try(vifx <-vif(lm(paste(outcome,"~."),testingset[,c(outcome,names(outcomeModel$coef)[-1])])))
sm <- summary(lmod)
if (length(lmod$coef)>10)
{
sm$coefficients[1,4] <- 1.0
gcoef <- lmod$coef[sm$coefficients[,4]<psig]
lmod <- lm(paste(outcome,"~."),testingset[,c(outcome,names(gcoef))])
try(vifx <-vif(lm(paste(outcome,"~."),testingset[,c(outcome,names(gcoef))])))
}
sm <- summary(lmod)
smcoef <- as.data.frame(sm$coefficients)
smcoef <- smcoef[order(-abs(smcoef[,3])),]
smcoef$Uni_t_values <- rawunittvalues[rownames(smcoef)]
if (!inherits(vif,"try-error")) smcoef$vif <-vifx[rownames(smcoef)]
smcoef <- smcoef[!is.na(smcoef$Uni_t_values),]
if (nrow(smcoef)>10) smcoef <- smcoef[smcoef[,4]<psig,]
pander::pander(smcoef)
| Estimate | Std. Error | t value | Pr(>|t|) | Uni_t_values | vif | |
|---|---|---|---|---|---|---|
| O1 | 0.02304 | 0.00265 | 8.69 | 4.87e-18 | 9.467 | 1.84 |
| C8 | -0.01862 | 0.00225 | -8.28 | 1.56e-16 | -18.654 | 1.37 |
| A3 | -0.01653 | 0.00202 | -8.17 | 3.83e-16 | -14.764 | 1.25 |
| N2 | -0.01588 | 0.00216 | -7.34 | 2.58e-13 | -1.496 | 1.36 |
| N7 | -0.01449 | 0.00208 | -6.95 | 4.00e-12 | -14.874 | 1.56 |
| E10 | -0.01386 | 0.00210 | -6.60 | 4.49e-11 | -11.288 | 1.54 |
| A1 | -0.01121 | 0.00174 | -6.44 | 1.30e-10 | -10.467 | 1.21 |
| C4 | -0.01272 | 0.00220 | -5.78 | 7.95e-09 | -16.127 | 1.57 |
| A7 | 0.01113 | 0.00226 | 4.92 | 8.75e-07 | -4.492 | 1.40 |
| gender | 0.02249 | 0.00471 | 4.77 | 1.87e-06 | 2.235 | 1.11 |
| C5 | 0.00950 | 0.00204 | 4.66 | 3.23e-06 | 12.496 | 1.36 |
| O8 | -0.01088 | 0.00235 | -4.63 | 3.77e-06 | -0.140 | 1.84 |
| E5 | 0.01025 | 0.00222 | 4.63 | 3.81e-06 | 9.291 | 1.66 |
| C10 | 0.01069 | 0.00237 | 4.51 | 6.50e-06 | 10.096 | 1.23 |
| E9 | -0.00811 | 0.00181 | -4.48 | 7.74e-06 | 0.599 | 1.35 |
| N6 | 0.00945 | 0.00225 | 4.20 | 2.76e-05 | -6.137 | 1.87 |
| N3 | -0.00974 | 0.00249 | -3.91 | 9.26e-05 | -8.653 | 1.67 |
| N5 | 0.00765 | 0.00202 | 3.78 | 1.56e-04 | -4.218 | 1.38 |
| N1 | -0.00842 | 0.00225 | -3.74 | 1.88e-04 | -8.452 | 1.83 |
| O9 | 0.00871 | 0.00234 | 3.73 | 1.93e-04 | 3.492 | 1.13 |
| C3 | -0.00860 | 0.00238 | -3.61 | 3.06e-04 | 2.279 | 1.23 |
| C2 | 0.00633 | 0.00183 | 3.46 | 5.40e-04 | -5.052 | 1.31 |
pander::pander(t(c(R2=sm$r.squared,adj_R2=sm$adj.r.squared)))
| R2 | adj_R2 |
|---|---|
| 0.188 | 0.185 |
pander::pander(c(numvar=nrow(smcoef)))
| numvar |
|---|
| 22 |
lmod_DE <- lm(paste(outcome,"~."),testage_DE[,c(outcome,names(outcomeModel_DE$coef)[-1])])
try(vifx <-vif(lm(paste(outcome,"~."),testage_DE[,c(outcome,names(outcomeModel_DE$coef)[-1])])))
sm <- summary(lmod_DE)
if (length(lmod_DE$coef)>10)
{
sm$coefficients[1,4] <- 1.0
gcoef <- lmod_DE$coef[sm$coefficients[,4]<psig]
lmod_DE <- lm(paste(outcome,"~."),testage_DE[,c(outcome,names(gcoef))])
try(vifx <-vif(lm(paste(outcome,"~."),testage_DE[,c(outcome,names(gcoef))])))
}
sm <- summary(lmod_DE)
lacoef <- as.data.frame(sm$coefficients)
lacoef <- lacoef[order(-abs(lacoef[,3])),]
lacoef$Uni_t_values <- deunittvalues[rownames(lacoef)]
if (!inherits(vifx,"try-error")) lacoef$vif <-vifx[rownames(lacoef)]
lacoef <- lacoef[!is.na(lacoef$Uni_t_values),]
if (nrow(lacoef)>10) lacoef <- lacoef[lacoef[,4]<psig,]
lacoef$formula <- theCharformulas[rownames(lacoef)]
lacoef$VarRatio <- varratios[str_remove_all(rownames(lacoef),"La_")]
pander::pander(lacoef)
| Estimate | Std. Error | t value | Pr(>|t|) | Uni_t_values | vif | formula | VarRatio | |
|---|---|---|---|---|---|---|---|---|
| La_C8 | -0.01871 | 0.00221 | -8.45 | 3.91e-17 | -14.670 | 1.14 | - (0.187)N8 + (0.336)C1 + C8 | 0.844 |
| La_N7 | -0.02119 | 0.00268 | -7.92 | 3.03e-15 | -10.014 | 1.05 | + N7 - (0.738)N8 | 0.411 |
| La_A3 | -0.01624 | 0.00206 | -7.89 | 3.80e-15 | -11.035 | 1.12 | - (0.179)N8 + A3 + (0.363)A4 | 0.864 |
| La_N2 | -0.01590 | 0.00216 | -7.35 | 2.27e-13 | -7.321 | 1.07 | + (0.318)N1 + N2 + (0.137)N6 + (0.085)N8 | 0.738 |
| O1 | 0.01428 | 0.00206 | 6.95 | 4.24e-12 | 9.467 | 1.11 | NA | 1.000 |
| E5 | 0.01163 | 0.00182 | 6.41 | 1.64e-10 | 9.291 | 1.12 | NA | 1.000 |
| N8 | -0.01084 | 0.00171 | -6.32 | 2.84e-10 | -10.878 | 1.14 | NA | 1.000 |
| La_E10 | -0.01330 | 0.00218 | -6.11 | 1.10e-09 | -7.452 | 1.10 | + (0.353)E5 + (0.293)E7 + E10 | 0.637 |
| La_C4 | -0.01335 | 0.00221 | -6.03 | 1.72e-09 | -9.541 | 1.11 | - (0.237)N8 - (0.200)C2 + C4 - (0.313)C6 | 0.684 |
| La_A1 | -0.01009 | 0.00178 | -5.68 | 1.41e-08 | -9.179 | 1.06 | - (0.073)E5 + A1 + (0.286)A4 - (0.307)A7 | 0.843 |
| La_C6 | -0.00992 | 0.00192 | -5.18 | 2.31e-07 | -8.757 | 1.10 | + (0.244)C1 - (0.472)C2 + C6 | 0.702 |
| La_O8 | -0.01190 | 0.00235 | -5.07 | 4.11e-07 | -7.975 | 1.07 | - (0.710)O1 + O8 | 0.605 |
| La_C10 | 0.01179 | 0.00239 | 4.94 | 8.12e-07 | 8.382 | 1.05 | - (0.231)C1 - (0.271)C3 + C10 | 0.825 |
| La_A7 | 0.01101 | 0.00230 | 4.79 | 1.69e-06 | 1.118 | 1.08 | + (0.238)E5 + (0.480)A4 + A7 | 0.729 |
| gender | 0.02087 | 0.00469 | 4.45 | 8.93e-06 | 2.235 | 1.10 | NA | 1.000 |
| La_N3 | -0.01068 | 0.00246 | -4.33 | 1.49e-05 | -4.593 | 1.16 | - (0.488)N1 + N3 | 0.688 |
| A4 | 0.00950 | 0.00223 | 4.26 | 2.07e-05 | 6.858 | 1.15 | NA | 1.000 |
| La_N6 | 0.00867 | 0.00208 | 4.17 | 3.13e-05 | -0.403 | 1.11 | + N6 - (0.525)N8 | 0.712 |
| La_C5 | 0.00862 | 0.00214 | 4.03 | 5.73e-05 | 8.181 | 1.09 | - (0.289)C1 + (0.196)C2 + C5 - (0.315)C9 | 0.724 |
| La_E8 | 0.00742 | 0.00191 | 3.88 | 1.08e-04 | 3.424 | 1.09 | - (0.230)E2 + (0.258)E5 - (0.050)E7 + E8 | 0.835 |
| La_N1 | -0.00707 | 0.00209 | -3.38 | 7.33e-04 | -4.312 | 1.09 | + N1 - (0.423)N6 - (0.199)N8 | 0.683 |
| O9 | 0.00758 | 0.00234 | 3.24 | 1.19e-03 | 3.492 | 1.13 | NA | 1.000 |
pander::pander(t(c(R2=sm$r.squared,adj_R2=sm$adj.r.squared)))
| R2 | adj_R2 |
|---|---|
| 0.188 | 0.184 |
pander::pander(c(numvar=nrow(lacoef)))
| numvar |
|---|
| 22 |
xvals <-c(min(c(deunittvalues,rawunittvalues))-3,max(c(deunittvalues,rawunittvalues))+3)
par(mfrow=c(1,2),cex=0.5)
plot(smcoef[,c(3,5)],
main="Raw: Univariate t-values vs regression t-values",
xlim=xvals,
ylim=xvals
)
lmtvals <- lm(smcoef[,5]~smcoef[,3])
pred <- lmtvals$coefficients[1] + lmtvals$coefficients[2] * xvals
lines(x=xvals,y=pred,col="red")
text(xvals[1]+(xvals[2]-xvals[1])/2,xvals[2]-1,sprintf("Slope= %.2f",lmtvals$coefficients[2]))
plot(lacoef[-1,c(3,5)],
main="ILAA: Univariate t-values vs regression t-values",
xlim=xvals,
ylim=xvals
)
lmtvals <- lm(lacoef[,5]~lacoef[,3])
pred <- lmtvals$coefficients[1] + lmtvals$coefficients[2] * xvals
lines(x=xvals,y=pred,col="red")
text(xvals[1]+(xvals[2]-xvals[1])/2,xvals[2]-1,sprintf("Slope= %.2f",lmtvals$coefficients[2]))
#pander::pander(summary(lmtvals))
pander::pander(cor.test(smcoef[,3],smcoef[,5]))
| Test statistic | df | P value | Alternative hypothesis | cor |
|---|---|---|---|---|
| 4.68 | 20 | 0.000143 * * * | two.sided | 0.723 |
pander::pander(cor.test(lacoef[,3],lacoef[,5]))
| Test statistic | df | P value | Alternative hypothesis | cor |
|---|---|---|---|---|
| 14.3 | 20 | 5.95e-12 * * * | two.sided | 0.954 |
par(op)
par(mfrow=c(1,3),cex=0.5)
plot(lmod$fitted.values,predOutcome,main="Raw: lm train predict vs. test predict",xlab="Train",ylab="Test")
plot(lmod_DE$fitted.values,predOutcome_DE,main="ILAA: lm train predict vs. test predict",xlab="Train",ylab="Test")
plot(predOutcome,predOutcome_DE,xlab="Raw Predicted",ylab="ILAA Predicted",main="Raw vs. ILAA")
par(op)
par(op)
corresults <- CV_IDeA(dataframe,outcome,loops=loops)
………. ………. ……….
mintvals <- min(c(min(corresults$rawtValues),min(corresults$detValues)))
maxvals <- max(c(max(corresults$rawtValues),max(corresults$detValues)))
xvals <- c(mintvals,maxvals)
vioplot(list(raw=corresults$testRawCorrelations,ILAA=corresults$testDeCorrelations),
ylab="Pearson Correlation",
main="Test Correlations")
pander::pander(t.test(corresults$testDeCorrelations,corresults$testRawCorrelations,paired=TRUE))
| Test statistic | df | P value | Alternative hypothesis | mean difference |
|---|---|---|---|---|
| 4.92 | 29 | 3.16e-05 * * * | two.sided | 0.00213 |
sylim <- c(1,min(c(20,max(corresults$VIFRaw))))
vioplot(list(raw=corresults$VIFRaw,ILAA=corresults$VIFDe),
ylab="VIF",
ylim=sylim,
main="Test VIF")
pander::pander(summary(cbind(raw=corresults$VIFRaw,ILAA=corresults$VIFDe)))
| raw | ILAA |
|---|---|
| Min. :2.032 | Min. :1.222 |
| 1st Qu.:2.099 | 1st Qu.:1.270 |
| Median :2.177 | Median :1.290 |
| Mean :2.439 | Mean :1.283 |
| 3rd Qu.:2.910 | 3rd Qu.:1.304 |
| Max. :3.048 | Max. :1.320 |
summary(corresults$VIFRaw)
Min. 1st Qu. Median Mean 3rd Qu. Max. 2.032 2.099 2.177 2.439 2.910 3.048
par(op)
par(mfrow=c(1,2),cex=0.5)
plot(corresults$rawtValues,
main="Raw: Univariate t-values vs Model t-values",
xlab="Univariate",
ylab="Model",
xlim=xvals,
ylim=xvals)
lmtvals <- lm(Model~.,corresults$rawtValues)
pred <- lmtvals$coefficients[1] + lmtvals$coefficients[2] * xvals
lines(x=xvals,y=pred,col="red")
text(xvals[1]+(xvals[2]-xvals[1])/2,xvals[2]-1,sprintf("Slope= %.2f",lmtvals$coefficients[2]))
pander::pander(summary(lmtvals))
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.0717 | 0.0928 | 0.773 | 4.40e-01 |
| Uni | 0.3111 | 0.0110 | 28.213 | 9.91e-136 |
| Observations | Residual Std. Error | \(R^2\) | Adjusted \(R^2\) |
|---|---|---|---|
| 1244 | 3.21 | 0.391 | 0.39 |
plot(corresults$detValues,
main="ILAA: Univariate t-values vs Model t-values",
xlab="Univariate",
ylab="Model",
xlim=xvals,
ylim=xvals)
lmtvals <- lm(Model~.,corresults$detValues)
pred <- lmtvals$coefficients[1] + lmtvals$coefficients[2] * xvals
lines(x=xvals,y=pred,col="red")
text(xvals[1]+(xvals[2]-xvals[1])/2,xvals[2]-1,sprintf("Slope= %.2f",lmtvals$coefficients[2]))
pander::pander(summary(lmtvals))
| Estimate | Std. Error | t value | Pr(>|t|) | |
|---|---|---|---|---|
| (Intercept) | 0.339 | 0.05405 | 6.27 | 4.81e-10 |
| Uni | 0.620 | 0.00846 | 73.24 | 0.00e+00 |
| Observations | Residual Std. Error | \(R^2\) | Adjusted \(R^2\) |
|---|---|---|---|
| 1272 | 1.89 | 0.809 | 0.808 |
toPCA <- sapply(apply(dataframe,2,unique),length) >= 5 & colnames(dataframe) != outcome
pc <- prcomp(dataframe[,toPCA],center = TRUE,scale. = TRUE,tol=0.01) #principal components
if (ncol(dataframe)<20)
{
pander::pander(as.data.frame(pc$rotation),caption="PCA")
}
rotstd <- log10(abs(100*pc$rotation)+1.0)
gplots::heatmap.2(rotstd,
trace = "none",
dendrogram="none",
breaks=c(0,0.5,1,2,3),
# scale="row",
mar = c(5,5),
col=rainbow(4),
main = "PCA Rotation",
cexRow = cexheat,
cexCol = cexheat,
Rowv=FALSE,
Colv=FALSE,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="log(|100Rot|+1)",
xlab="Output Feature", ylab="Input Feature")
efa <- try(fa(dataframe[,toPCA],ncol(pc$rotation),rotate="varimax",warnings=FALSE)) # EFA analysis
if (!inherits(efa,"try-error"))
{
if (ncol(dataframe)<20)
{
pander::pander(as.data.frame(efa$weights),caption="EFA")
}
rotstd <- log10(abs(100*efa$weights)+1.0)
gplots::heatmap.2(rotstd,
trace = "none",
dendrogram="none",
breaks=c(0,0.5,1,2,3),
# scale="row",
mar = c(5,5),
col=rainbow(4),
main = "EFA weights",
cexRow = cexheat,
cexCol = cexheat,
Rowv=FALSE,
Colv=FALSE,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="log(|100W|+1)",
xlab="Output Feature", ylab="Input Feature")
}
plm <- plsr(formula=formula(paste(outcome,"~.")),data=dataframe,scale =TRUE)
if (ncol(dataframe)<20)
{
lds <- plm$loadings
lds2 <- matrix(as.numeric(lds),nrow=nrow(lds),ncol=ncol(lds))
colnames(lds2) <- colnames(lds)
rownames(lds2) <- rownames(lds)
pander::pander(lds2,caption="PLS")
}
loadadings <- log10(abs(100*plm$loadings) + 1.0)
gplots::heatmap.2(loadadings,
breaks=c(0,0.5,1,2,3),
trace = "none",
dendrogram="none",
# scale="row",
mar = c(5,5),
col=rainbow(4),
main = "PLS Loadings",
cexRow = cexheat,
cexCol = cexheat,
Rowv=FALSE,
Colv=FALSE,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="log(|100Beta|+1)",
xlab="Output Feature", ylab="Input Feature")
ERTmod <- ILAA(dataframe,Outcome = outcome,thr=thro)
ERT <- log10(abs(100*attr(ERTmod,"UPLTM")) + 1);
gplots::heatmap.2(ERT,
trace = "none",
breaks=c(0,0.5,1,2,3),
mar = c(5,5),
col=rainbow(4),
main = "ERT Rotation",
cexRow = cexheat,
cexCol = cexheat,
dendrogram="none",
Rowv=FALSE,
Colv=FALSE,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="log(|100Beta|+1)",
xlab="Output Feature", ylab="Input Feature")
if (ncol(dataframe)<20)
{
pander::pander(attr(ERTmod,"UPLTM"),caption="ERT")
}
thesamples <- c(1:nrow(dataframe));
if (nrow(dataframe)>2000)
{
thesamples <- sample(thesamples,2000)
}
classes <- as.integer(scale(dataframe[thesamples,outcome]))
classes <- classes - min(classes) + 1
raincolors <- heat.colors(length(unique(classes)))
dtatoplot <- as.matrix(FRESAScale(dataframe[thesamples,],method="OrderLogit")$scaledData)
datasetframe.umap = umap(dtatoplot,n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: RAW",col=raincolors[classes],pch=15)
gplots::heatmap.2(dtatoplot,
trace = "none",
mar = c(5,5),
col=heat.colors(5),
main = "Raw",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="Z",
xlab="Feature", ylab="Subject")
dtatoplot <- as.matrix(FRESAScale(predict(pc,dataframe[thesamples,]),method="OrderLogit")$scaledData)
datasetframe.umap = umap(dtatoplot,n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: PCA",col=raincolors[classes],pch=15)
gplots::heatmap.2(dtatoplot,
trace = "none",
mar = c(5,5),
col=heat.colors(5),
main = "PCA",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="Z",
xlab="Feature", ylab="Subject")
if (!inherits(efa,"try-error"))
{
dtatoplot <- as.matrix(FRESAScale(predict(efa,dataframe[thesamples,toPCA]),method="OrderLogit")$scaledData)
datasetframe.umap = umap(dtatoplot,n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: EFA",col=raincolors[classes],pch=15)
gplots::heatmap.2(dtatoplot,
trace = "none",
mar = c(5,5),
col=heat.colors(5),
main = "EFA",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="Z",
xlab="Feature", ylab="Subject")
}
rotframe <- as.matrix(scale(dataframe[thesamples,rownames(plm$loadings)])) %*% plm$loadings
dtatoplot <- as.matrix(FRESAScale(rotframe,method="OrderLogit")$scaledData)
datasetframe.umap = umap(dtatoplot,n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: PLS",col=raincolors[classes],pch=15)
gplots::heatmap.2(dtatoplot,
trace = "none",
mar = c(5,5),
col=heat.colors(5),
main = "PLS",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="Z",
xlab="Feature", ylab="Subject")
dtatoplot <- as.matrix(FRESAScale(ERTmod[thesamples,colnames(ERTmod) != outcome],method="OrderLogit")$scaledData)
datasetframe.umap = umap(dtatoplot,n_components=2)
plot(datasetframe.umap$layout,xlab="U1",ylab="U2",main="UMAP: ERT",col=raincolors[classes],pch=15)
gplots::heatmap.2(dtatoplot,
trace = "none",
mar = c(5,5),
col=heat.colors(5),
main = "ERT",
cexRow = cexheat,
cexCol = cexheat,
srtCol=45,
srtRow=45,
key.title=NA,
key.xlab="Z",
xlab="Feature", ylab="Subject")
plot(10^predOutcome,10^testingset[,outcome],xlab="Raw Predicted",ylab=outcome,main="Age Prediction")
plot(10^predOutcome_DE,10^testingset[,outcome],xlab="IDeA Predicted",ylab=outcome,main="Age Prediction")